﻿Sub 打开VICO图标文件(hWndForm As hWnd, n图标 As String)
   Dim i  As Long, f As Long = 1, f2 As Long, u As Long
   Dim ss As String = n图标, nn As StringW = App.ProductName & WStr("_ ") & App.FileMajor & "." & App.FileMinor & "." & App.FileRevision & "." & App.FileBuild
   If LenW(vico文件) = 0 Then
      nn &= WStr(" (*新图标*)")
   Else
      nn &= " ("
      nn &= vico文件
      nn &= ")"
   End If
   Form1.Caption = nn
   Erase t图标列表, t图标显示, 恢复记录,t图标恢复记录
   i恢复 = 0
   u恢复 = 0
   k恢复 = 1
   Dim tss As String, sel As Long 
   f = InStr(ss, "<sel>")
   If f Then 
      f2 = InStr(ss, "</sel>")
      If f2 Then 
         sel = ValInt(Mid(ss,f+5,f2-f-5))
      End If 
   End If 
   
   
   Do
      f = InStr(ss, "<vico>")
      If f = 0 Then Exit Do
      ss = Mid(ss, f + 6)
      f  = InStr(ss, "</vico>")
      If f Then
         tss = Trim(Left(ss, f -1))
         ss  = Mid(ss, f + 7)
      Else
         tss = Trim(ss)
         ss  = ""
      End If
      If Len(tss) Then
         ReDim Preserve t图标列表(u), t图标显示(u),t图标恢复记录(u)
         t图标列表(u) = tss
         t图标显示(u) = tss
         u += 1
      End If
   Loop
   If u = 0 Then ReDim Preserve t图标列表(0), t图标显示(0),t图标恢复记录(0)
   
   Form1.YFList1.Clear
   For i = 0 To UBound(t图标列表)
      If Left(t图标列表(i), 1) = "{" Then
         f = InStr(t图标列表(i), "}")
         If f = 0 Then f = Len(t图标列表(i)) + 1
         Form1.YFList1.AddItem Utf8toStringW(Mid(t图标列表(i), 2, f -2)), 0, i
      Else
         Form1.YFList1.AddItem "", 0, i
      End If
   Next
   If sel < 0 Or  sel > UBound(t图标列表) Then sel =0
   Form1.YFList1.ListIndex = sel 
   Form1_YFList1_SelChange(hWndForm, 0, sel)
   k恢复 = 0
End Sub
Sub 加载图标(VIco As String, p As Long = 0)
   'VIco字符串，由3个部分组成：{图标名字}(色彩列表)绘画字符串
   '图标名字：由 前后 {} 包裹，文字编码是UTF8编码
   '色彩列表: 16进制GDI+的颜色值，逗号分割，用来代替初始颜色表，例题：FF000000,FFFF0000,FF00FF00
   '绘画字符串：有多段命令和参数组成
   '先后次序，必须是 名称+颜色+绘画 前后无空格。
   
   代码修改中 = 1
   'Print "加载图标",VIco
   Dim i As Long, f As Long, f2 As Long
   
   '获取颜色     -------------------
   '初始颜色
   Dim sColor(16) As Long '= {0, &HFF000000, &HFFFF0000, &HFF00FF00, &HFF0000FF, &HFFFFFF00, &HFF00FFFF, &HFFFF00FF, &HFFFFFFFF, &HFFC0C0C0, &HFF808080, &HFF008080, &HFF008000, &HFF808000, &HFF800080, &HFF800000, &HFF000080}
   For i = 1 To 16
      sColor(i) = 原始颜色(i)
   Next
   
   
   Dim ci   As Long
   Dim Cm() As String
   '色彩列表 ----------------------------
   f = 1 'VIco 绘图处理位置，可能有色彩列表，就向后移动。
   If Left(VIco, 1) = "{" Then
      f = InStr(2, VIco, "}")
      If f = 0 Then f = Len(VIco) + 1
      Form1.YFtext9.Text = Utf8toStringW(Mid(VIco, 2, f -2))
      f += 1
      If p = 0 Then Form1.YFtext2.Text = Utf8toStringW(Mid(VIco, f))
   Else
      Form1.YFtext9.Text = ""
      If p = 0 Then Form1.YFtext2.Text = Utf8toStringW(VIco)
   End If
   If Mid(VIco, f, 1) = "(" Then
      ci = 1 '颜色索引号
      For i = f To Len(VIco) -1
         If VIco[i] = 44 Or VIco[i] = 41 Or i = Len(VIco) -1 Then '遇到 ,)
            If ci < 17 Then
               If i - f > 0 Then
                  sColor(ci) = ValInt("&H" & Mid(VIco, f + 1, i - f))
               End If
            End If
            f = i + 1
            If VIco[i] = 41 Then Exit For
            ci += 1
         End If
      Next
      f += 1
   End If
   Form1.YFList3.Clear
   For i = 1 To UBound(sColor)
      Form1.YFList3.AddItem "", 0, sColor(i)
   Next
   
   Form1.YFList3.ListIndex = 0
   Form1_YFList3_SelChange(0, 0, 0)
   Form1.YFtext3(0).UpMax = UBound(sColor)
   Form1.YFtext3(1).UpMax = UBound(sColor)
   '获取元素   ----------------------
   Form1.YFList2.Clear
   ReDim t元素列表(100) '创建大的，避免频繁申请内存，速度奇慢
   ReDim t元素显示(100)
   i = 0
   Dim vs As String, kf As Long
   
   If Len(VIco) Then
      Do
         '寻找一个描绘命令
         f2 = InStr(f, VIco, "+")
         If f2 = 0 Then f2 = Len(VIco) + 1
         vs = Mid(VIco, f, f2 - f)
         If i > UBound(t元素列表) Then ReDim Preserve t元素列表(i + 30), t元素显示(i + 30)
         If i Then
            If Mid(vs, 2, 1) = "*" Then '遇到与上一个元素相同的字符
               vs = Left(vs, 1) & Mid(t元素列表(i -1), 2, Asc(vs, 3) -47) & Mid(vs, 4)
            End If
            If Asc(vs, 1) = 105 Then kf = 0 Else kf = InStr(vs, "%") '除文字以外，寻找克隆体
            If kf Then '克隆体
               Dim As Long ku, ki, kx, ky, kt, kax, kay
               Dim ks As String
               ku = Asc(vs, kf + 1) -48 '坐标个数
               'x 偏移值
               kt = Asc(vs, kf + 2)
               If kt <= 64 Then
                  kx = kt -48
                  kf += 3
               Else
                  kx = (kt -65) * 55 + (Asc(vs, kf + 3) -65) -1000
                  kf += 4
               End If
               'y 偏移值
               kt = Asc(vs, kf)
               If kt <= 64 Then
                  ky = kt -48
               Else
                  ky = (kt -65) * 55 + (Asc(vs, kf + 1) -65) -1000
               End If
               'Print ku, kx, kt
               '去上一个获取坐标值
               For ki = Len(t元素列表(i -1)) - ku * 4 + 1 To Len(t元素列表(i -1)) -3 Step 4
                  '解码数字要 -1000 ，加码数字要 + 1000  因此相互抵消，没有 1000 处理
                  kax = (Asc(t元素列表(i -1), ki) -65)     * 55 + (Asc(t元素列表(i -1), ki + 1) -65) + kx
                  kay = (Asc(t元素列表(i -1), ki + 2) -65) * 55 + (Asc(t元素列表(i -1), ki + 3) -65) + ky
                  ks  &= Chr(Int(kax / 55) + 65, (kax Mod 55) + 65, Int(kay / 55) + 65, (kay Mod 55) + 65)
               Next
               kf = InStr(vs, "%")
               vs = Left(vs, kf -1) & ks '恢复数据
            End If
         End If
         
         If Len(vs) Then
            t元素列表(i) = vs
            t元素显示(i) = 1
            i += 1
         End If
         If f2 >= Len(VIco) Then Exit Do
         f = f2 + 1
      Loop
   End If
   If i = 0 Then '没有元素
      Erase t元素列表, t元素显示
      Form1_YFList2_SelChange(0, 0, -1)
   Else
      ReDim Preserve t元素列表(i -1), t元素显示(i -1)
      Dim n As WString * 10
      For i = UBound(t元素列表) To 0 Step -1
         Select Case Left(t元素列表(i), 1)
            Case "a"  : n = WStr("线条")
            Case "b"  : n = WStr("矩形")
            Case "c"  : n = WStr("椭圆")
            Case "d"  : n = WStr("圆弧")
            Case "e"  : n = WStr("多边形")
            Case "f"  : n = WStr("贝塞尔曲线")
            Case "g"  : n = WStr("曲线")
            Case "h"  : n = WStr("路径")
            Case "i"  : n = WStr("文字")
            Case Else : n = WStr("*错误*")
         End Select
         Form1.YFList2.AddItem n
      Next
      
      代码修改中 = 1
      Form1.YFList2.ListIndex = 0
      Form1_YFList2_SelChange(0, 0, 0)
   End If
   代码修改中 = 0
End Sub
Sub 合成VICO数据()
   Dim vico As String
   Dim as long i
   
   '获取颜色 ---------------------------
   
   Dim sc As String, c As Long
   For i = 15 To 0 Step -1
      c = Form1.YFList3.ItemData(i)
      If c <> 原始颜色(i + 1) Or Len(sc) > 0 Then
         If Len(sc) Then sc = "," & sc
         If c <> 原始颜色(i + 1) Then
            sc = Hex(c) & sc
         End If
      End If
   Next
   
   If Len(sc) Then
      t颜色 = "(" & sc & ")"
      
   Else
      t颜色 = ""
   End If
   '获取元素   ----------------------
   vico =t颜色 & 合成输出显示字符串()
   代码修改中         = 1
   Form1.YFtext2.Text = Utf8toStringW(vico)
   代码修改中         = 0
   文件被修改         = 1
   Form1.YFbunGroup5.ButtonState(Form1_YFbunGroup1_Button_保存) = 0
   创建恢复()
   sc = wStrToUtf8(Form1.YFtext9.Text)
   If Len(sc) Then
      sc = YF_Replace(sc, "{", "")
      sc = YF_Replace(sc, "}", "")
      sc = "{" & sc & "}"
   End If
   t图标列表(i图标) = sc & vico
   
   vico = ""
   If UBound(t元素列表) > -1 Then
      For i = 0 To UBound(t元素列表)
         If t元素显示(i) Then
            If Len(vico) Then vico &= "+"
            vico &= t元素列表(i)
         End If
      Next
   End If
   vico = t颜色 & vico
   t图标显示(i图标) = vico
   Form1.Picture1.Refresh
   Form1.Picture2.Refresh
   Form1.YFList1.Refresh
   Form1.YFList2.Refresh
End Sub
Sub 合成元素数据()

   If i元素 >= 0 And i元素 <= UBound(t元素列表) Then
      Dim i As Long,nn As String 
      Select Case Left(t元素列表(i元素), 1)
         Case "a", "f", "g", "h"
            '直线 <a,填充色,填充模式,闭合路径,折线拐角,线框色,线粗,起点线帽,终点线帽,终点箭头w,终点箭头h,箭头填充,起点箭头w,起点箭头h,x1,y1,x2,y2,....xn,yn>
            ''描绘贝塞尔曲线 <f,填充色,填充模式,闭合路径,折线拐角,线框色,线粗,起点线帽,终点线帽,终点箭头w,终点箭头h,箭头填充,起点箭头w,起点箭头h,x1,y1,x2,y2,x3,y3,x4,y4...[xn,yn]>
            '描绘曲线 <g,填充色,填充模式,闭合路径,折线拐角,线框色,线粗,起点线帽,终点线帽,终点箭头w,终点箭头h,箭头填充,起点箭头w,起点箭头h,曲度,x1,y1,x2,y2,....xn,yn>
            '路径 <h,填充色,填充模式,闭合路径,折线拐角,线框色,线粗,起点线帽,终点线帽,终点箭头w,终点箭头h,箭头填充,起点箭头w,起点箭头h,n,x1,y1,x2,y2,x3,y3,x4,y4...[xn,yn]>
            nn = Left(t元素列表(i元素), 1) & _
               整数转V数(字符转换数字(Form1.YFtext3(0).text, 16)) & _ ' 填充色
               整数转V数(Form1.Combo2.ListIndex) & _ ' 填充模式
               IIf(Form1.Check4.Value, 1, 0)     & _ ' 闭合路径
               整数转V数(Form1.Combo5.ListIndex * 3 + Form1.Combo3.ListIndex) & _ ' 折线拐角
               整数转V数(字符转换数字(Form1.YFtext3(1).text, 16)) & _  ' 线框色
               整数转V数(字符转换数字(Form1.YFtext4.text)) & _         ' 线粗
               整数转V数(Form1.Combo1(0).ListIndex)        & _         '起点线帽
               整数转V数(Form1.Combo1(1).ListIndex)        & _         '终点线帽
               整数转V数(字符转换数字(Form1.YFtext5(2).text, 500)) & _ '终点W
               整数转V数(字符转换数字(Form1.YFtext5(3).text, 500)) & _ '终点H
               整数转V数(IIf(Form1.Check2.Value, 1, 0)) & _ ' 箭头填充
               整数转V数(字符转换数字(Form1.YFtext5(0).text, 500)) & _ '起点W
               整数转V数(字符转换数字(Form1.YFtext5(1).text, 500)) '起点H
            If Left(t元素列表(i元素), 1) = "g" Then
               nn &= 整数转V数(字符转换数字(Form1.YFtext1(2).text, 1000, -1000)) '曲度
            End If
            For i = 0 To UBound(t对象列表)
               nn &= 文字坐标组转字符(t对象列表(i))
            Next
         Case "b" '矩形 <b,填充色,线框色,线粗,圆角w,圆角h,圆角位置1 Or 2 Or 4 Or 8（1 左上角.2 左下角.4 右上角.8 右下角）,x,y,w,h>
            ''              1      2     3     4     5      6                                                            7 8 9 10
            i = 0
            If Form1.Check1(0).Value Then i Or= 1
            If Form1.Check1(1).Value Then i Or= 2
            If Form1.Check1(2).Value Then i Or= 4
            If Form1.Check1(3).Value Then i Or= 8
            nn = "b" & _
               整数转V数(字符转换数字(Form1.YFtext3(0).text, 16))  & _ ' 填充色
               整数转V数(字符转换数字(Form1.YFtext3(1).text, 16))  & _ ' 线框色
               整数转V数(字符转换数字(Form1.YFtext4.text))         & _ ' 线粗
               整数转V数(字符转换数字(Form1.YFtext6(0).text, 100)) & _ ' 圆角w
               整数转V数(字符转换数字(Form1.YFtext6(1).text, 100)) & _ ' 圆角h
               整数转V数(i) & _ ' 圆角位置1
               整数转V数(t调节点(1).x) & 整数转V数(t调节点(1).y) & 整数转V数(t调节点(2).x - t调节点(1).x) & 整数转V数(t调节点(2).y - t调节点(1).y)
            
         Case "c" ' WStr("椭圆")<c,填充色,线框色,线粗,x,y,w,h>
            nn = "c" & _
               整数转V数(字符转换数字(Form1.YFtext3(0).text, 16)) & _ ' 填充色
               整数转V数(字符转换数字(Form1.YFtext3(1).text, 16)) & _ ' 线框色
               整数转V数(字符转换数字(Form1.YFtext4.text))        & _ ' 线粗
               整数转V数(t调节点(1).x) & 整数转V数(t调节点(1).y) & 整数转V数(t调节点(2).x - t调节点(1).x) & 整数转V数(t调节点(2).y - t调节点(1).y)
            
         Case "d" ' '圆弧 <d,填充色,填充模式,闭合路径,折线拐角,线框色,线粗,起点线帽,终点线帽,终点箭头w,终点箭头h,箭头填充,起点箭头w,起点箭头h,x,y,w,h,相对于x轴的起始角度(0度为原的右边中部),顺时针转了多少角度>
            nn = "d" & _
               整数转V数(字符转换数字(Form1.YFtext3(0).text, 16)) & _ ' 填充色
               整数转V数(Form1.Combo2.ListIndex) & _ ' 填充模式
               IIf(Form1.Check4.Value, 1, 0)     & _ ' 闭合路径
               整数转V数(Form1.Combo5.ListIndex * 3 + Form1.Combo3.ListIndex) & _ ' 折线拐角
               整数转V数(字符转换数字(Form1.YFtext3(1).text, 16)) & _  ' 线框色
               整数转V数(字符转换数字(Form1.YFtext4.text)) & _         ' 线粗
               整数转V数(Form1.Combo1(0).ListIndex)        & _         '起点线帽
               整数转V数(Form1.Combo1(1).ListIndex)        & _         '终点线帽
               整数转V数(字符转换数字(Form1.YFtext5(2).text, 500)) & _ '终点W
               整数转V数(字符转换数字(Form1.YFtext5(3).text, 500)) & _ '终点H
               整数转V数(IIf(Form1.Check2.Value, 1, 0)) & _ ' 箭头填充
               整数转V数(字符转换数字(Form1.YFtext5(0).text, 500)) & _ '起点W
               整数转V数(字符转换数字(Form1.YFtext5(1).text, 500)) '起点H
            
            nn &= 整数转V数(t调节点(1).x) & 整数转V数(t调节点(1).y) & 整数转V数(t调节点(2).x - t调节点(1).x) & 整数转V数(t调节点(2).y - t调节点(1).y)
            nn &= 整数转V数(字符转换数字(Form1.YFtext1(4).text, 360, -360)) '相对于x轴的起始角度(0度为原的右边中部)
            nn &= 整数转V数(字符转换数字(Form1.YFtext1(5).text, 360, -360)) '顺时针转了多少角度
            
         Case "e" '<e,填充色,线框色,线粗,圆角w,圆角h,折线拐角,几个边,旋转角度,x,y,w,h>
            nn = "e" & _
               整数转V数(字符转换数字(Form1.YFtext3(0).text, 16))  & _ ' 填充色
               整数转V数(字符转换数字(Form1.YFtext3(1).text, 16))  & _ ' 线框色
               整数转V数(字符转换数字(Form1.YFtext4.text))         & _ ' 线粗
               整数转V数(字符转换数字(Form1.YFtext6(0).text, 100)) & _ ' 圆角w
               整数转V数(字符转换数字(Form1.YFtext6(1).text, 100)) & _ ' 圆角h
               整数转V数(Form1.Combo5.ListIndex * 3 + Form1.Combo3.ListIndex) & _ ' 折线拐角
               整数转V数(字符转换数字(Form1.YFtext1(4).text, 360, 3))    & _ '几个边
               整数转V数(字符转换数字(Form1.YFtext1(5).text, 360, -360)) & _ '旋转角度
               整数转V数(t调节点(1).x) & 整数转V数(t调节点(1).y) & 整数转V数(t调节点(2).x - t调节点(1).x) & 整数转V数(t调节点(2).y - t调节点(1).y)
         Case "i" '描绘文字 <i,填充色,线框色,线粗,折线拐角,尺寸,加粗,倾斜,下划线,删除线,x,y,长度(字体名和文字总长度),字体名,文字>
            nn = "i" & _
               整数转V数(字符转换数字(Form1.YFtext3(0).text, 16)) & _ ' 填充色
               整数转V数(字符转换数字(Form1.YFtext3(1).text, 16)) & _ ' 线框色
               整数转V数(字符转换数字(Form1.YFtext4.text)) & _  ' 线粗
               整数转V数(Form1.Combo5.ListIndex * 3 + Form1.Combo3.ListIndex)  ' 折线拐角
            nn &= 整数转V数(字符转换数字(Form1.YFtext6(2).text,500, 5)) ' 尺寸
            For i = 0 To 3
               nn &= IIf(Form1.Check5(i).Value, 1, 0) '加粗,倾斜,下划线,删除线
            Next
            nn &= 整数转V数(t调节点(1).x) & 整数转V数(t调节点(1).y) 
            Dim tc As String = Form1.Combo4.Text  & "," & Form1.YFtext10.Text
            tc=YF_Replace(tc,"+","")
            nn &= 整数转V数(Len(tc)) & "&" & wStrToUtf8(tc)
      End Select
      '处理 重复的 0 ，进一步压缩字符 因为0重复比较多
      Dim f1 As Long, f2 As Long
      i=1
      Do 
         If i >= Len(nn) Then Exit Do 
         If f1 Then 
            If nn[i] <> 48 Then 
               If i - f1 > 2 Then 
                  nn = Left(nn, f1 -1+1) & Chr(46, i - f1 + 48) & Mid(nn, i+1)
                  i=f1+1
               End If     
               f1=0
            End If 
         Else    
            If nn[i]=48 Then f1=i  
         End If 
         i +=1
      Loop    
      t元素列表(i元素)=nn 
   End If
   
   合成VICO数据()
End Sub
Function 字符转换数字(n As String, 最大 As Long = 1000, 最小 As Long = 0) As Long
   Dim k As Long = valint(n)
   If k < 最小 Then k = 最小
   If k > 最大 Then k = 最大
   Function = k
End Function

Function 整数转V数(nn As Long) As String '把数值转为 VICO 的55进制数字符串
   If nn >= 0 And nn <= 16 Then 
      '短数字 ，直接就是 0 -- 16 
      Return Chr(nn + 48)
   Else
      '长数字，55进制，有2个字符组成，可以表示 0--3000 。实际表示 -1000 到 2000 ，因此需要 +1000 处理。
      Dim a As Long, b As Long
      a = nn + 1000
      If a < 0    Then a = 0
      If a > 3000 Then a = 3000
      b = a Mod 55
      a = Int(a / 55)
      Return Chr(a + 65, b + 65)
   End If
End Function
Function 文字坐标组转字符(nn As String) As String
   Dim f As Long = InStr(nn, ",")
   If f = 0 Then Return nn
   Return 整数转V数(ValInt(Left(nn, f -1))) & 整数转V数(ValInt(Mid(nn, f + 1)))
End Function
Function 判断和前一个元素有多少同的(aa As String, bb As String) As Long '不判断第一个字符，返回除第一个字符后面相同的数量
   Dim a As Long = Len(aa), b As Long = Len(bb), u As Long
   u = IIf(a > b, b, a)
   If u < 4 Then Return 0
   Dim i As Long
   If u > 74 Then u = 74 '最大74
   For i = 1 To u -1 '不判断第一个字符，返回除第一个字符后面相同的数量
      If aa[i] <> bb[i] Then
         If i < 3 Then Return 0 '相同数太少，无意义。
         Return i -1
      End If
   Next
   Function = u -1 '全部相同
End Function
Function 判断和前一个元素克隆(aa As String, bb As String) As String '和前一个是克隆的，只是坐标偏移不同，就只记录偏移量
   Dim ia As Long = Len(aa), ib As Long = Len(bb)
   Dim As Long px, py, spx, spy, xa, ya, xb, yb, jj
   '从尾巴开始判断，2个文字判断
   Do
      ia -= 4
      ib -= 4
      If ia < 3 Or ib < 3 Then Exit Do
      If aa[ia] < 65 Or aa[ia] > 120         Then Exit Do
      If aa[ia + 1] < 65 Or aa[ia + 1] > 120 Then Exit Do
      If aa[ia + 2] < 65 Or aa[ia + 2] > 120 Then Exit Do
      If aa[ia + 3] < 65 Or aa[ia + 3] > 120 Then Exit Do
      If bb[ib] < 65 Or bb[ib] > 120         Then Exit Do
      If bb[ib + 1] < 65 Or bb[ib + 1] > 120 Then Exit Do
      If bb[ib + 2] < 65 Or bb[ib + 2] > 120 Then Exit Do
      If bb[ib + 3] < 65 Or bb[ib + 3] > 120 Then Exit Do
      
      xa = (aa[ia] - 65)     * 55 + (aa[ia + 1] -65)
      ya = (aa[ia + 2] - 65) * 55 + (aa[ia + 3] -65)
      xb = (bb[ib] - 65)     * 55 + (bb[ib + 1] -65)
      yb = (bb[ib + 2] - 65) * 55 + (bb[ib + 3] -65)
      
      px = xb - xa
      py = yb - ya

      If jj = 0 Then '第一次，记录偏移
         spx = px
         spy = py
      Else
         If Abs(spx - px) > 3 Or Abs(spy - py) > 3 Then Exit Do '偏移不同,由于 1000比例，存在误差，用ABS() 消除小误差
      End If
      jj += 1      
   Loop
   If jj > 2 Then '存在克隆
      Function = Left(bb, Len(bb) - jj * 4) & Chr(37,jj + 48) & 整数转V数(spx) & 整数转V数(spy)  '"%" 
   Else
      Function = bb '没有克隆
   End If
End Function
Function 合成输出显示字符串() As String
   Dim vico   As String, i    As Long
   Dim 相同数 As Long, 克隆体 As String
   If UBound(t元素列表) > -1 Then
      For i = 0 To UBound(t元素列表)
         
         If i Then
            vico   &= "+"
            克隆体 = 判断和前一个元素克隆(t元素列表(i -1), t元素列表(i))
            相同数 = 判断和前一个元素有多少同的(t元素列表(i -1), 克隆体)
         Else
            克隆体 = t元素列表(i)
         End If
         If 相同数 Then '判断和前一个元素有多少同的,进一步减少字符串
            vico &= Left(克隆体, 1) & Chr(42, 相同数 + 47) & Mid(克隆体, 相同数 + 2)
         Else
            vico &= 克隆体
         End If
      Next
   End If
   Function = vico
End Function




